このサイトは、安藤道人・大西連「」に掲載しているグラフを、インタラクティブなグラフとして掲載している。各グラフの説明については、この記事を参照されたい。

また、元データやRMarkdownファイルはGitHubの「household_support_monthly」のフォルダで公開しているほか、本サイトでもコードは確認できるようにしている。

## Generate "long" data frames for RMarkdown and R analysis

# Select necesssary data for raw-number df
df_num <- df_merge %>% select(prefec, date, category, number)

# Wide > Long data
df_long_num <- df_num %>% group_by(prefec,category,date) %>%
  mutate(id = dplyr::row_number()) %>% 
  tidyr::pivot_wider(names_from = category, values_from = number)
## "spread" version: tidyr::spread(key = category, value = number)

# Select necesssary data for per capita df
df_pop <- df_merge %>% select(prefec, date, category,per_pop)

# Wide > Long data
df_long_pop <- df_pop %>% group_by(prefec,category,date) %>%
  mutate(id = dplyr::row_number()) %>% 
  tidyr::pivot_wider(names_from = category, values_from = per_pop)
## "spread" version: tidyr::spread(key =  category, value = per_pop)
##「被保護者調査」のデータ読み込み##

# 変数名の英語化
df <- combined_df %>% rename("city" = "統計表1 生活保護の被保護世帯数及び実人員",
                             "municipality" = "...2",
                             "households_total" = "...4" ,
                             "households_receive" = "...5",
                             "households_suspend" = "...6",
                             "persons_total" = "...7",
                             "persons_receive" = "...8",
                             "persons_suspend" = "...9",
                             "households_start" = "...10",
                             "households_end" = "...11" )

#municipalityと同じ列に全国を追加する
df <- df %>% mutate(municipality= dplyr::case_when(
  city == "全国" ~ "全国",
  TRUE ~ df$municipality
))

df <- df %>% select(-city, -"...3")

df <- subset(df, !(is.na(df$municipality)))

df[,2:9] <- lapply(df[,2:9], as.numeric)
##自治体コードの読み込みと統合##

region_code <- read_excel("region_code.xls")

region_code <- region_code  %>% rename("municipality" =   "市区町村名\n(漢字)")

df <- dplyr::full_join(df, region_code, by = "municipality")

df <-df %>% rename("prefecture" = "都道府県名\n(漢字)")

df <- df %>% select(-"団体コード",-"都道府県名\n(カナ)", -"市区町村名\n(カナ)")

df <- df[, c(10,1,11,2,3,4,5,6,7,8,9)]
##「被保護者調査」の前処理##

for (i in 1:nrow(df)){
if (is.na(df[i,3])){
   df[i,3] <- df[i,2]
}else {
  df[i,3] <- df[i,3]
}}

df$prefecture <- stringr::str_replace(df$prefecture, "県", "")
df$prefecture <-stringr::str_replace(df$prefecture, "府", "")
df$prefecture <-stringr::str_replace(df$prefecture, "東京都", "東京")


df <- aggregate(df[c("households_total","households_receive","households_suspend","persons_total" ,"persons_receive","persons_suspend","households_start","households_end")], by=list(df$prefecture, df$year_month), FUN=sum)

df <- df %>% rename("prefecture"  = "Group.1",
                    "year_month" = "Group.2")
##都道府県人口の読み込みと統合##

population <- read_excel("prefec_pop_estimates2019.xlsx")

population$prefec <- stringr::str_replace(population$prefec, "県", "")
population$prefec <-stringr::str_replace(population$prefec, "府", "")
population$prefec <-stringr::str_replace(population$prefec, "東京都", "東京")

population$population  <- stringr::str_replace(population$population, ",", "")

population$population <- as.numeric(population$population)

population$population <- population$population

population <- population %>% rename("prefecture" = "prefec")

df <- dplyr::full_join(df, population, by = "prefecture")
##「被保護者調査」の変数名の日本語化(shiny用のため使用せず)##
df <- df %>% rename("都道府県"  = "prefecture",
                    "年月" = "year_month",
                    "被保護世帯数_総数" = "households_total",
                    "被保護世帯数_現に保護を受けたもの" = "households_receive",
                    "被保護世帯数_保護停止中のもの"  = "households_suspend",
                    "被保護実人員_総数" = "persons_total",
                    "被保護実人員_現に保護を受けたもの" = "persons_receive",
                    "被保護実人員_保護停止中のもの" = "persons_suspend",
                    "保護開始世帯数" = "households_start",
                    "保護廃止世帯数" = "households_end"
                    )
## 「被保護者調査」の前処理 ##

#全国データの抽出
df_all  <- df %>% filter(prefecture == "全国")

#都道府県データの抽出
df <- df %>% filter(prefecture != "全国")

#全国データの前月差データの作成
df_all <- df_all %>% mutate(diff_households_total = NA) 

for (i in 2:nrow(df_all)) {
  df_all$diff_households_total[i] <- df_all$households_total[i] - df_all$households_total[i-1]
}

df_all$diff_households_total[1] <- 0

df_all <- df_all %>% mutate(diff_persons_total = NA) 

for (i in 2:nrow(df_all)) {
  df_all$diff_persons_total[i] <- df_all$persons_total[i] - df_all$persons_total[i-1]
}

df_all$diff_persons_total[1] <- 0

df_all <- df_all %>% mutate(per_mille_diff_households_total = df_all$diff_households_total/df_all$population)

df_all <- df_all%>% mutate(per_mille_diff_persons_total = df_all$diff_persons_total/df_all$population)


df <- df %>% mutate(per_mille_households_total = df$households_total/df$population)

df <- df %>% mutate(per_mille_persons_total = df$persons_total/df$population)

df <- df %>% mutate(per_mille_households_start = df$households_start/df$population)

df <- df %>% mutate(per_mille_households_end = df$households_end/df$population)

df <- df[order(df$prefecture, decreasing=F),]

df <- df %>% mutate(diff_households_total = NA) 

for (i in 2:nrow(df)) {
  df$diff_households_total[i] <- df$households_total[i] - df$households_total[i-1]
}

df[df$year_month=="2019-01-01", "diff_households_total"] <- 0

df <- df %>% mutate(per_mille_diff_households_total = df$diff_households_total/df$population)

df <- df %>% mutate(diff_persons_total = NA) 

for (i in 2:nrow(df)) {
  df$diff_persons_total[i] <- df$persons_total[i] - df$persons_total[i-1]
}

df[df$year_month=="2019-01-01", "diff_persons_total"] <- 0

df <- df %>% mutate(per_mille_diff_persons_total = df$diff_persons_total/df$population)
#Wide > Long, using "number" ()
df_all_long <- df_all %>%
  tidyr::pivot_longer(col = -c("prefecture","year_month" ,"population"), names_to = "category", values_to = "number")

## "gather" version: df_all_long <- tidyr::gather(data = df_all, key = "category", value = "number",-c("prefecture","year_month" ,"population"))

df_all_long <- df_all_long %>% mutate(per_pop = df_all_long$number/df_all_long$population)

## Old, Change unit :df_all_long$number <- df_all_long$number/10000 

df_all_long <- df_all_long[order(df_all_long$category, decreasing=F),]

df_all_long <- df_all_long %>% mutate(diff = NA) 

for (i in 2:nrow(df_all_long)) {
  df_all_long$diff[i] <- df_all_long$number[i] - df_all_long$number[i-1]
}

df_all_long[df_all_long$year_month=="2019-01-01", "diff"] <- 0
# df_long <- tidyr::gather(data = df, key = "category", value = "number",-c("prefecture","year_month" ,"population"))

df_long <- df %>%
  tidyr::pivot_longer(col = -c("prefecture","year_month" ,"population"), names_to = "category", values_to = "number")

df_long <- df_long %>% mutate(per_pop = df_long$number/df_long$population)


df_long <- df_long[order(df_long$prefecture, decreasing=F),]

df_long <- df_long %>% mutate(diff = NA) 

df_long <- df_long[order(df_long$category, decreasing=F),]

for (i in 2:nrow(df_long)) {
  df_long$diff[i] <- df_long$number[i] - df_long$number[i-1]
}

df_long[df_long$year_month=="2019-01-01", "diff"] <- 0

#df_wide <- df_long %>% tidyr::spread(data = df_long, key = "category", value = "per_mille",-c("prefecture","year_month" ,"population", "number"))
# df_long <- tidyr::gather(data = df, key = "category", value = "number",-c("prefecture","year_month" ,"population"))

df_long <- df %>%
  tidyr::pivot_longer(col = -c("prefecture","year_month" ,"population"), names_to = "category", values_to = "number")

df_long <- df_long %>% mutate(per_pop = df_long$number/df_long$population)


df_long <- df_long[order(df_long$prefecture, decreasing=F),]

df_long <- df_long %>% mutate(diff = NA) 

df_long <- df_long[order(df_long$category, decreasing=F),]

for (i in 2:nrow(df_long)) {
  df_long$diff[i] <- df_long$number[i] - df_long$number[i-1]
}

df_long[df_long$year_month=="2019-01-01", "diff"] <- 0

#df_wide <- df_long %>% tidyr::spread(data = df_long, key = "category", value = "per_mille",-c("prefecture","year_month" ,"population", "number"))

1 全国での集計値

1.1 生活保護世帯数

seikatsu <- df_all_long

seikatsu  <- seikatsu %>% filter(category == "households_total")

seikatsu  <- seikatsu %>% rename("households_total"= number)

seikatsu$households_total <- seikatsu$households_total/10000

g_seiho_households <- seikatsu %>% ggplot(aes(x = year_month, y = households_total)) +
     geom_line(stat = "identity",  colour = "#1177CC") +
      geom_point(stat = "identity", colour = "#1177CC") +
      theme_minimal(base_family = font) +
    scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
     theme(axis.text.x = element_text(angle = 30, hjust = 1)) +
     ylab("被保護世帯(単位:1万世帯)")  +
      xlab("年月") +
      scale_y_continuous(limits = c(155, 165),oob = rescale_none)

ggplotly(g_seiho_households)

1.2 生活保護世帯数の前月差

seikatsu <-  df_all_long

seikatsu  <- seikatsu %>% filter(category == "households_total")

seikatsu  <- seikatsu %>% rename("diff_households_total"= diff)

g_seiho_households_diff <- seikatsu %>% ggplot(aes(x=year_month, y=diff_households_total)) +
     geom_line(stat = "identity",  colour = "#1177CC") +
      geom_point(stat = "identity", colour = "#1177CC") +
      theme_minimal(base_family = font) +
    scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
     ylab("被保護世帯(単位:1万世帯)")  +
      xlab("年月") +
      geom_hline(yintercept = 0, color = "black", linetype = "dashed") +
     theme(axis.text.x = element_text(angle= 0, hjust = 1))
    
ggplotly(g_seiho_households_diff)

1.3 生活保護人員数

seikatsu <-  df_all_long

seikatsu  <- seikatsu %>% filter(category == "persons_total")

seikatsu  <- seikatsu %>% rename("persons_total"= number)

seikatsu$persons_total <- seikatsu$persons_total/10000

g_seiho_people <- seikatsu %>% ggplot(aes(x=year_month, y=persons_total)) +
    geom_line(stat = "identity",  colour = "#1177CC") +
      geom_point(stat = "identity", colour = "#1177CC") +
      theme_minimal(base_family = font) +
    scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
     theme(axis.text.x = element_text(angle = 30, hjust = 1))+
     ylab("被保護世帯(単位:1万人)")  +
      xlab("年月") +
      scale_y_continuous(limits = c(200,  210),oob = rescale_none)
    
ggplotly(g_seiho_people)

1.4 生活保護人員数の前月差

seikatsu <-  df_all_long

seikatsu  <- seikatsu %>% filter(category == "persons_total")

seikatsu  <- seikatsu %>% rename("diff_persons_total"= diff)

g_seiho_people_diff <- seikatsu %>% ggplot(aes(x=year_month, y=diff_persons_total)) +
    geom_line(stat = "identity",  colour = "#1177CC") +
      geom_point(stat = "identity", colour = "#1177CC") +
      theme_minimal (base_family = font) +
    scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
     theme(axis.text.x = element_text(angle = 30, hjust = 1))+
     ylab("被保護世帯(単位:1万人)")  +
      xlab("年月") +
      geom_hline(yintercept = 0, color = "black", linetype = "dashed") +
      geom_vline(aes(xintercept = as.Date("2020-01-01")))
    
ggplotly(g_seiho_people_diff)

1.5 住居確保給付金

1.5.1 住居確保給付金の申請件数

jukyo1901_2006 <- df_long_num %>% select(prefec, date, jukyo_apply)

jukyo1901_2006 <-na.omit(jukyo1901_2006)

jukyo1901_2006  <- jukyo1901_2006  %>% filter(prefec == "全国")

jukyo1901_2006 <- jukyo1901_2006 %>% rename("year_month" = date)

g_jukyo_apply <- jukyo1901_2006 %>% ggplot(aes(x = year_month, y = jukyo_apply)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal(base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
   theme(axis.text.x = element_text(angle = 30, hjust = 1))+
   xlab("年月") +
   ylab("申請件数")+
   labs(colour="prefecture")+
   scale_y_continuous(limits = c(0, 45000),oob = rescale_none) +
   theme(legend.position="none")

ggplotly(g_jukyo_apply)
# グラフ統合用
g_jukyo_apply <- g_jukyo_apply + ggtitle("(a)申請件数") +
     theme(axis.text.x = element_text(angle = 30, hjust = 1))

1.5.2 住居確保給付金の決定件数

jukyo1901_2006 <- df_long_num %>% select(prefec, date, jukyo_number)

jukyo1901_2006 <-na.omit(jukyo1901_2006)

jukyo1901_2006  <- jukyo1901_2006  %>% filter(prefec == "全国")

jukyo1901_2006 <- jukyo1901_2006 %>% rename("year_month" = date, "prefecture" = prefec)

g_jukyo_number <- jukyo1901_2006 %>% ggplot(aes(x = year_month, y = jukyo_number)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal(base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
   theme(axis.text.x = element_text(angle = 30, hjust=1))+
   xlab("年月") +
   ylab("決定件数")+
   labs(colour="prefecture")+
   scale_y_continuous(limits = c(0, 45000),oob = rescale_none) +
   theme(legend.position="none")

ggplotly(g_jukyo_number)
# グラフ統合用
g_jukyo_number <- g_jukyo_number + ggtitle("(b)決定件数") +
     theme(axis.text.x = element_text(angle = 30, hjust=1))

1.5.3 住居確保給付金の支給済額

jukyo1901_2006 <- df_long_num %>% select(prefec, date, jukyo_payment_amount)

jukyo1901_2006 <-na.omit(jukyo1901_2006)

jukyo1901_2006  <- jukyo1901_2006  %>% filter(prefec == "全国")

jukyo1901_2006$jukyo_payment_amount <- jukyo1901_2006$jukyo_payment_amount/100000

jukyo1901_2006 <- jukyo1901_2006 %>% rename("year_month" = date)

g_jukyo_amounts <- jukyo1901_2006 %>% ggplot(aes(x = year_month, y = jukyo_payment_amount)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal(base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
   theme(axis.text.x = element_text(angle = 30, hjust=1))+
   xlab("年月") +
   ylab("支給済額(単位:億円)") +
   theme(legend.position="none") 

ggplotly(g_jukyo_amounts)
# 出力用グラフ
g_jukyo_amounts <- g_jukyo_amounts +  labs(title = "図3 住居確保給付金の支給済額(単位:億円)",
      caption = "注:2019年4月から2020年3月については統計が欠損している。出典:厚生労働省提供資料")

# png出力
ggsave(file = "jukyo_amounts.png", plot = g_jukyo_amounts, width = 5, height = 4) 

1.6 緊急小口資金・総合支援資金

1.6.1 緊急小口資金の申請件数

koguchi_1901_2008 <- df_long_num %>% select(prefec, date,koguchi_apply)

koguchi_1901_2008 <- na.omit(koguchi_1901_2008)
   
koguchi_1901_2008 <- koguchi_1901_2008  %>% filter(prefec == "全国")

koguchi_1901_2008 <- koguchi_1901_2008 %>% rename("year_month" = date)

g_koguchi_apply <- koguchi_1901_2008 %>% ggplot(aes(x = year_month, y = koguchi_apply)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal (base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m",
                limit=c(as.Date("2019-01-01"),as.Date("2020-08-01"))) +
   scale_y_continuous(limits = c(0, 200000),oob = rescale_none) +
   theme(axis.text.x = element_text(angle = 30, hjust=1))+
   xlab("年月") +
   ylab("申請件数")+
   theme(legend.position="none") 

ggplotly(g_koguchi_apply)
g_koguchi_apply <- g_koguchi_apply + ggtitle("(a)緊急小口資金の申請件数") +
      theme(axis.text.x = element_text(angle=30, hjust=1))

1.6.2 緊急小口資金の決定件数

koguchi_1901_2008 <- df_long_num %>% select(prefec, date,koguchi_number)

koguchi_1901_2008 <- na.omit(koguchi_1901_2008)
   
koguchi_1901_2008 <- koguchi_1901_2008  %>% filter(prefec == "全国")

koguchi_1901_2008 <- koguchi_1901_2008 %>% rename("year_month" = date)

g_koguchi_number <- koguchi_1901_2008 %>% ggplot(aes(x = year_month, y = koguchi_number)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal (base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
   scale_y_continuous(limits = c(0, 200000),oob = rescale_none) +
   theme(axis.text.x = element_text(angle = 30, hjust=1))+
   xlab("年月") +
   ylab("決定件数")+
   theme(legend.position="none")

ggplotly(g_koguchi_number)
g_koguchi_number <- g_koguchi_number + ggtitle("(b)緊急小口資金の決定件数") +
      theme(axis.text.x = element_text(angle=30, hjust=1))

1.6.3 総合支援資金の申請件数

sogo_1901_2001 <- df_long_num %>% select(prefec, date,sogo_apply)

sogo_1901_2001 <- na.omit(sogo_1901_2001)
   
sogo_1901_2001 <- sogo_1901_2001   %>% filter(prefec == "全国")

sogo_1901_2001  <- sogo_1901_2001  %>% rename("year_month" = date)

g_sogo_apply <- sogo_1901_2001 %>% ggplot(aes(x = year_month, y = sogo_apply)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal (base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m",
                limit=c(as.Date("2019-01-01"),as.Date("2020-08-01"))) +
   scale_y_continuous(limits = c(0, 200000),oob = rescale_none) +
   theme(axis.text.x = element_text(angle = 30, hjust = 1))+
   xlab("年月") +
   ylab("申請件数")+
   theme(legend.position="none")

ggplotly(g_sogo_apply)
# 統合用
g_sogo_apply <- g_sogo_apply + ggtitle("(c)総合支援資金の申請件数") +
     theme(axis.text.x = element_text(angle=30, hjust=1))

1.6.4 総合支援資金の決定件数

sogo_1901_2001 <- df_long_num %>% select(prefec, date,sogo_number)

sogo_1901_2001 <- na.omit(sogo_1901_2001)
   
sogo_1901_2001 <- sogo_1901_2001   %>% filter(prefec == "全国")

sogo_1901_2001  <- sogo_1901_2001  %>% rename("year_month" = date)

g_sogo_number  <- sogo_1901_2001 %>% ggplot(aes(x = year_month, y =sogo_number)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal (base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
   scale_y_continuous(limits = c(0, 200000),oob = rescale_none) +
   theme(axis.text.x = element_text(angle=30, hjust=1))+
   xlab("年月") +
   ylab("決定件数")+
   theme(legend.position="none")

ggplotly(g_sogo_number)
g_sogo_number <- g_sogo_number  + ggtitle("(d)総合支援資金の決定件数")

1.6.5 緊急小口資金の決定金額

koguchi_1901_2008 <- df_long_num%>% select(prefec, date,koguchi_payment_amount)

koguchi_1901_2008 <- na.omit(koguchi_1901_2008)

koguchi_1901_2008   <-koguchi_1901_2008   %>% filter(prefec == "全国")

koguchi_1901_2008$koguchi_payment_amount <- koguchi_1901_2008$koguchi_payment_amount/100000

koguchi_1901_2008 <- koguchi_1901_2008 %>% rename("year_month" = date)

g_koguchi_amounts <- koguchi_1901_2008 %>% ggplot(aes(x = year_month, y = koguchi_payment_amount)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal (base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
   theme(axis.text.x = element_text(angle = 30, hjust=1))+
   xlab("年月") +
   ylab("決定金額(億円)")+
   theme(legend.position="none")

ggplotly(g_koguchi_amounts)
g_koguchi_amounts <- g_koguchi_amounts + ggtitle("(a)緊急小口資金の決定金額") +
      theme(axis.text.x = element_text(angle=30, hjust=1))

1.6.6 総合支援資金の決定金額

sogo_1901_2001 <- df_long_num %>% select(prefec, date,sogo_payment_amount)

sogo_1901_2001 <- na.omit(sogo_1901_2001)

sogo_1901_2001   <-sogo_1901_2001   %>% filter(prefec == "全国")

sogo_1901_2001$sogo_payment_amount <- sogo_1901_2001$sogo_payment_amount/100000

sogo_1901_2001  <- sogo_1901_2001  %>% rename("year_month" = date)

g_sogo_amounts <- sogo_1901_2001 %>% ggplot(aes(x = year_month, y = sogo_payment_amount)) +
  geom_line(stat = "identity",  colour = "#1177CC") +
   geom_point(stat = "identity", colour = "#1177CC") +
   theme_minimal (base_family = font) +
   scale_x_date(breaks = "2 month", date_labels = "%Y-%m") +
   theme(axis.text.x = element_text(angle=30, hjust=1))+
   xlab("年月") +
   ylab("決定金額(億円)")+
   theme(legend.position="none")

ggplotly(g_sogo_amounts)
g_sogo_amounts <- g_sogo_amounts + ggtitle("(b)総合支援資金の決定金額") +
      theme(axis.text.x = element_text(angle=30, hjust=1))